home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / Apr / di9804rs / AAlias.pas < prev    next >
Pascal/Delphi Source File  |  1997-12-29  |  4KB  |  155 lines
  1. unit AAlias;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TAntiAliasForm = class(TForm)
  11.     BigBox: TPaintBox;
  12.     OutBox: TPaintBox;
  13.     CmdGo: TButton;
  14.     InputText: TEdit;
  15.     Label1: TLabel;
  16.     Label2: TLabel;
  17.     Label3: TLabel;
  18.     function RGB(r, g, b : Integer) : TColor;
  19.     procedure SeparateColor(color : TColor; var r, g, b : Integer);
  20.     procedure CmdGoClick(Sender: TObject);
  21.     procedure FormCreate(Sender: TObject);
  22.     procedure BigBoxPaint(Sender: TObject);
  23.     procedure OutBoxPaint(Sender: TObject);
  24.     procedure FormDestroy(Sender: TObject);
  25.   private
  26.     { Private declarations }
  27.   public
  28.     { Public declarations }
  29.   end;
  30.  
  31. var
  32.   AntiAliasForm: TAntiAliasForm;
  33.  
  34. implementation
  35.  
  36. {$R *.DFM}
  37.  
  38. var
  39.     big_bm, out_bm : TBitmap;
  40.  
  41. function TAntiAliasForm.RGB(r, g, b : Integer) : TColor;
  42. begin
  43.     Result := r + 256 * (g + 256 * b) + $02000000;
  44. end;
  45.  
  46. procedure TAntiAliasForm.SeparateColor(color : TColor;
  47.     var r, g, b : Integer);
  48. begin
  49.     r := color Mod 256;
  50.     g := (color Div 256) Mod 256;
  51.     b := color Div 65536;
  52. end;
  53.  
  54. procedure TAntiAliasForm.CmdGoClick(Sender: TObject);
  55. var
  56.     txt                       : String;
  57.     wid, hgt, x, y, i, j      : Integer;
  58.     r, g, b, totr, totg, totb : Integer;
  59. begin
  60.     // Display the hourglass cursor.
  61.     Screen.Cursor := crHourGlass;
  62.  
  63.     txt := InputText.Text;
  64.  
  65.     // Use the correct colors.
  66.     big_bm.Canvas.Font.Color := InputText.Font.Color;
  67.     big_bm.Canvas.Brush.Color := InputText.Color;
  68.  
  69.     // Set the new font.
  70.     big_bm.Canvas.Font := InputText.Font;
  71.     big_bm.Canvas.Font.Size := 2 * InputText.Font.Size;
  72.     big_bm.Canvas.Refresh; // Make the font take effect.
  73.  
  74.     // Make big_bm and BigBox big enough.
  75.     wid := big_bm.Canvas.TextWidth(txt);
  76.     hgt := Round(big_bm.Canvas.TextHeight(txt) * 1.1);
  77.     big_bm.Width := wid;
  78.     big_bm.Height := hgt;
  79.     big_bm.Canvas.Refresh;
  80.     BigBox.Width := wid;
  81.     BigBox.Height := hgt;
  82.     BigBox.Refresh;
  83.  
  84.     // Draw the text in big_bm.
  85.     big_bm.Canvas.TextOut(0, 0, txt);
  86.  
  87.     // Display it in BigBox.
  88.     BigBox.Invalidate;
  89.  
  90.     // ********************************
  91.     // Anti-alias the text into out_bm.
  92.     // ********************************
  93.     // Create a new out_bm.
  94.     //  out_bm.Free;                    - Removed by RLV on 12/29/97
  95.     //  out_bm := TBitmap.Create;       - Removed by RLV on 12/29/97
  96.     out_bm.Width := wid Div 2;
  97.     out_bm.Height := hgt Div 2;
  98.     out_bm.Canvas.Refresh;
  99.  
  100.     // The "- 3" keeps us from falling off the edge
  101.     // of BigBox. Over the edge Point would
  102.     // return -1 and mess up the colors.
  103.     for y := 0 to (big_bm.Height - 3) Div 2 do
  104.     begin
  105.         for x := 0 to (big_bm.Width - 3) Div 2 do
  106.         begin
  107.             // Compute the value of output pixel (x, y).
  108.             totr := 0;
  109.             totg := 0;
  110.             totb := 0;
  111.             for j := 0 to 1 do
  112.             begin
  113.                 for i := 0 to 1 do
  114.                 begin
  115.                     SeparateColor(big_bm.Canvas.Pixels
  116.                         [2 * x + i, 2 * y + j], r, g, b);
  117.                     totr := totr + r;
  118.                     totg := totg + g;
  119.                     totb := totb + b;
  120.                 end;
  121.             end;
  122.             out_bm.Canvas.Pixels[x, y] :=
  123.                 RGB(totr Div 4, totg Div 4, totb Div 4);
  124.         end;
  125.     end;
  126.     OutBox.Invalidate;
  127.  
  128.     // Remove the hourglass cursor.
  129.     Screen.Cursor := crDefault;
  130. end;
  131.  
  132. procedure TAntiAliasForm.FormCreate(Sender: TObject);
  133. begin
  134.     big_bm := TBitmap.Create;
  135.     out_bm := TBitmap.Create;
  136. end;
  137.  
  138. procedure TAntiAliasForm.BigBoxPaint(Sender: TObject);
  139. begin
  140.     BigBox.Canvas.Draw(0, 0, big_bm);
  141. end;
  142.  
  143. procedure TAntiAliasForm.OutBoxPaint(Sender: TObject);
  144. begin
  145.     OutBox.Canvas.Draw(0, 0, out_bm);
  146. end;
  147.  
  148. procedure TAntiAliasForm.FormDestroy(Sender: TObject);
  149. begin
  150.   if big_bm <> nil then big_bm.Free;        {Added by RLV on 12/29/97}
  151.   if out_bm <> nil then out_bm.Free;        {Added by RLV on 12/29/97}
  152. end;
  153.  
  154. end.
  155.